;;;; -*- Mode: Lisp; Package: :dreaming-tree -*-
;;;;
;;;; render-states.lisp
;;;;

(in-package :dreaming-tree)

(defclass alpha (global-render-state)
  ())

(defclass cull (global-render-state)
  ())

(defclass material (global-render-state)
  ())

(defclass polygonoffset (global-render-state)
  ())

(defclass stencil (global-render-state)
  ())

(defclass wireframe (global-render-state)
  ())

(defclass zbuffer (global-render-state)
  ())

;;; Protocol for render state updates
(defgeneric rs-update (spatial)
  (:documentation "Entry point for render state update.  Performs a depth-first traversal of the scene graph updating active global states and lights at ."))
(defgeneric propagate-render-state-from-root (spatial gs-stack light-stack)
  (:documentation "Propagates global render states and lights from scene root to specified spatial object."))
(defgeneric push-render-state (spatial gs-stack light-stack)
  (:documentation "Push global render states and lights defined at current spatial on to the appropriate containers."))
(defgeneric pop-render-state (spatial gs-stack light-stack)
  (:documentation "Remove global render states and lights defined at current spatial from the appropriate containers."))
(defgeneric update-render-state (spatial gs-stack light-stack)
  (:documentation "Propagates the update at internal nodes, copies render state into appropriate data members at leaf nodes."))

(defgeneric enable-render-state (spatial state-type &key &allow-other-keys))
(defgeneric disable-render-state (spatial state-type))

(defparameter *allowed-global-rs* '(alpha cull material polygonoffset stencil wireframe zbuffer))

(defmethod print-slots ((r global-render-state))
  '(enabled-p))

(defun make-default-rs-stack ()
  (let ((rsstack (make-hash-table)))
    (dolist (rs *allowed-global-rs* rsstack)
      (let ((rsinstance (make-instance rs)))
	(setf (gethash rs rsstack) rsinstance)))))

(defun make-default-light-stack ()
  (make-list 1))

(defmethod detach-all-lights ((g geometry))
  (setf (lights g) (make-list 1)))

(defmethod attach-light ((g geometry) light)
  (pushnew light (lights g)))

(defmethod attach ((state global-render-state) (obj spatial))
  (setf (part-of state) obj)
  (pushnew state (global-states obj)))

;; Is this the right semantics for removal?  Should I be remove render-states by
;; object identity or by object type?
(defmethod dettach ((obj global-render-state) (g geometry))
  (setf (global-states g) (remove obj (global-states g))))

;;; Global Render State during the drawing pass ;;;
(defparameter *global-state* nil)

(defun get-active-render-states ()
  (unless *global-state*
    (setf *global-state* (make-default-rs-stack)))
  *global-state*)

(defun get-active-state (state &optional (state-stack (get-active-render-states)))
  (gethash (type-of state) state-stack))

(defun set-active-state (state &optional (state-stack (get-active-render-states)))
  (if (typep state 'cons) (warn "Object ~A is not of subtype of global-render-state." state))
  (setf (gethash (type-of state) state-stack) state))

(defmacro with-render-states-active (states &body body)
  `(let ((current-active (get-active-render-states)))
     (unwind-protect 
	  (progn
	    (dolist (s ,states)
	      (set-state s))
	    ,@body)
       (dolist (s ,states)
	 (set-state (get-active-state s current-active))))))

(defmethod draw ((grs global-render-state))
  (set-state grs))

;;; --- Wireframes ---
(defmethod enable-render-state ((obj spatial) (state (eql 'wireframe)) &key &allow-other-keys)
  (let ((s (find-if #'(lambda (x)
			(typep x 'wireframe))
		    (global-states obj))))
    (if s
	(setf (enabled-p s) t)
	(attach (make-instance 'wireframe :enabled-p t) obj))))

(defmethod disable-render-state ((obj spatial) (state (eql 'wireframe)))
  (let ((s (find-if #'(lambda (x)
			(typep x 'wireframe))
		    (global-states obj))))
    (when s
      (setf (enabled-p s) nil))))

(defmethod set-state ((state wireframe))
  (if (enabled-p state)
      (glPolygonMode GL_FRONT_AND_BACK GL_LINE)
      (glPolygonMode GL_FRONT_AND_BACK GL_FILL)))